home *** CD-ROM | disk | FTP | other *** search
/ Aminet 46 / Aminet 46 (2001)(GTI - Schatztruhe)[!][Dec 2001].iso / Aminet / text / edit / edt10src.lha / txt / GUI.mod < prev    next >
Text File  |  1995-04-08  |  12KB  |  429 lines
  1. (*
  2.   .name       GUI
  3.   .task       interface to Intuition and GadTools
  4.   .release    1.0
  5.   .language   Oberon-2
  6.   .translator Amiga Oberon 3.11
  7.   .system     AmigaOS 2.04/2.1/3.0
  8.   .author     Joachim Barheine
  9.   .address    Hochgrevestraße 3, D-38640 Goslar
  10.   .copyright  (c) 1994 by Joachim Barheine
  11. *)
  12.  
  13. (* .info: 30/01/95, 19:30:14, version 86 *)
  14.  
  15. MODULE GUI;
  16.  
  17. IMPORT
  18.   SYS:= SYSTEM,
  19.  
  20.   ASCII,
  21.   Err:= ErrCodes,
  22.   Exec,
  23.   ExecSupport,
  24.   GT:= GadTools,
  25.   Gfx:= Graphics,
  26.   IE:= InputEvent,
  27.   I:= Intuition,
  28.   IO:= IOServer,
  29.   K:= Kernel,
  30.   S:= Strings,
  31.   Util:= Utility;
  32.  
  33. CONST
  34.   uScoreCh* = "_";
  35.   uScore* = ORD(uScoreCh);
  36.   mxSpacing* = 3;
  37.   cbSpacing* = 3;
  38.   horizOffs* = 8;
  39.   vertOffs* = 4;
  40.  
  41.   escKey* =     ORD(ASCII.esc); (* hook *)
  42.   returnKey* = ORD(ASCII.cr);   (* hook *)
  43.   tabKey* =     ORD(ASCII.ht);  (* gaTabCycle *)
  44.  
  45. TYPE
  46.   LabelArray* = UNTRACED POINTER TO ARRAY 33 OF SYS.ADDRESS;
  47.  
  48. VAR
  49.   prev- : I.GadgetPtr;  (* for gadget creation *)
  50.   layoutX- , layoutY- , layoutSpc- : INTEGER;
  51.   editHook: Util.HookPtr;
  52.   reqFontSpec: Gfx.TextAttrPtr;
  53.   reqFont- : Gfx.TextFontPtr;
  54.  
  55.   xWd-, zeroWd-, checkBoxWd-, mxWd-, cycleImgWd-, uScoreWd-: INTEGER;
  56.   stringHt-, buttonHt-, checkBoxHt-, mxHt-, cycleHt-, textHt-,
  57.   vertSpc-, horizSpc- : INTEGER;
  58.  
  59.   idCnt: INTEGER;
  60.  
  61. PROCEDURE Flash* ;
  62.  
  63. BEGIN
  64.   I.DisplayBeep(IO.screen);
  65. END Flash;
  66.  
  67. PROCEDURE OpenReqWindowXY* (title: ARRAY OF CHAR; at: I.WindowPtr; x, y, w, h: INTEGER;
  68.                         idcmp: LONGSET; gadList: I.GadgetPtr): I.WindowPtr;
  69.  
  70. VAR
  71.   win: I.WindowPtr;
  72.  
  73. (* $CopyArrays- *)
  74.  
  75. BEGIN
  76.   win:= I.OpenWindowTagsA(NIL, I.waPubScreen, IO.screen,
  77.                         I.waLeft, x, I.waTop, y,
  78.                         I.waInnerWidth, w, I.waInnerHeight, h,
  79.                         I.waTitle, SYS.ADR(title),
  80.                         I.waDragBar, I.LTRUE, I.waDepthGadget, I.LTRUE,
  81.                         I.waActivate, I.LTRUE,
  82.                         I.waAutoAdjust, I.LTRUE, I.waSimpleRefresh, I.LTRUE,
  83.                         I.waRMBTrap, I.LTRUE,
  84.                         I.waGadgets, gadList,
  85.                         I.waIDCMP, idcmp, Util.done);
  86.   IF win # NIL THEN
  87.     GT.RefreshWindow(win, NIL);
  88.   END;
  89.   RETURN win;
  90. END OpenReqWindowXY;
  91.  
  92. PROCEDURE OpenReqWindow* (title: ARRAY OF CHAR; at: I.WindowPtr; w, h: INTEGER;
  93.                           idcmp: LONGSET; gadList: I.GadgetPtr): I.WindowPtr;
  94.  
  95. (* $CopyArrays- *)
  96.  
  97. BEGIN
  98.   RETURN OpenReqWindowXY(title, at, at.leftEdge + at.borderLeft + 8,
  99.                          at.topEdge + at.borderTop + 4, w, h, idcmp, gadList);
  100. END OpenReqWindow;
  101.  
  102. PROCEDURE GetMax* (VAR x: INTEGER; xn: INTEGER);
  103.  
  104. BEGIN
  105.   IF xn > x THEN x:= xn END;
  106. END GetMax;
  107.  
  108. PROCEDURE TextWidth* (text: ARRAY OF CHAR): INTEGER;
  109.  
  110. VAR
  111.   i, w, l: INTEGER;
  112.  
  113. (* $CopyArrays- *)
  114.  
  115. BEGIN
  116.    l:= SHORT(S.Length(text));
  117.    w:= Gfx.TextLength(SYS.ADR(IO.screen.rastPort), text, l);
  118.    FOR i:= 0 TO l - 1 DO
  119.      IF text[i] = uScoreCh THEN DEC(w, uScoreWd) END;
  120.    END;
  121.    RETURN w;
  122. END TextWidth;
  123.  
  124. PROCEDURE NewCol* (x, y, spc: INTEGER);
  125.  
  126. BEGIN
  127.   IF x # -1 THEN layoutX:= x END;
  128.   IF y # -1 THEN layoutY:= y END;
  129.   IF spc # -1 THEN layoutSpc:= spc END;
  130. END NewCol;
  131.  
  132. PROCEDURE InitNewGadget* (VAR ng: GT.NewGadget; id: INTEGER; width, height: INTEGER;
  133.                         label: ARRAY OF CHAR; flags: LONGSET);
  134.  
  135. (* $CopyArrays- *)
  136.  
  137. BEGIN
  138.   ng.leftEdge:=   layoutX + IO.screen.wBorLeft;
  139.   ng.topEdge:=    layoutY + IO.screen.wBorTop + IO.screen.font.ySize + 1;
  140.   ng.width:=      width;
  141.   ng.height:=     height;
  142.   ng.gadgetID:=   id;
  143.   ng.visualInfo:= IO.visualInfo;
  144.   ng.textAttr:=   reqFontSpec;
  145.   IF label = "" THEN ng.gadgetText:= NIL ELSE ng.gadgetText:= SYS.ADR(label) END;
  146.   ng.flags:=      flags;
  147.   INC(layoutY, height + layoutSpc);
  148. END InitNewGadget;
  149.  
  150. PROCEDURE CreateContextGad* (VAR gadList: I.GadgetPtr): I.GadgetPtr;
  151.  
  152. BEGIN
  153.   prev:= GT.CreateContext(gadList);
  154.   RETURN prev;
  155. END CreateContextGad;
  156.  
  157. PROCEDURE CreateCheckBoxGad* (id: INTEGER; label: ARRAY OF CHAR;
  158.                             checked, enabled: BOOLEAN): I.GadgetPtr;
  159.  
  160. VAR
  161.   ng: GT.NewGadget;
  162.  
  163. (* $CopyArrays- *)
  164.  
  165. BEGIN
  166.   InitNewGadget(ng, id, checkBoxWd, checkBoxHt, label, LONGSET{GT.placeTextRight});
  167.   prev:= GT.CreateGadget(GT.checkBoxKind, prev, ng, GT.underscore, uScore,
  168.                          GT.cbScaled, I.BoolToLong(checkBoxHt # 11),
  169.                          GT.cbChecked, I.BoolToLong(checked),
  170.                          I.gaDisabled, I.BoolToLong(~enabled),
  171.                          Util.done);
  172.   RETURN prev;
  173. END CreateCheckBoxGad;
  174.  
  175. PROCEDURE CreateButtonGad* (id: INTEGER; label: ARRAY OF CHAR; width: INTEGER;
  176.                           enabled: BOOLEAN): I.GadgetPtr;
  177.  
  178. VAR
  179.   ng: GT.NewGadget;
  180.  
  181. (* $CopyArrays- *)
  182.  
  183. BEGIN
  184.   InitNewGadget(ng, id, width, buttonHt, label, LONGSET{GT.placeTextIn});
  185.   prev:= GT.CreateGadget(GT.buttonKind, prev, ng, GT.underscore, uScore,
  186.                          I.gaDisabled, I.BoolToLong(~enabled), Util.done);
  187.   RETURN prev;
  188. END CreateButtonGad;
  189.  
  190. PROCEDURE CreateStringGad* (id: INTEGER; label: ARRAY OF CHAR; width: INTEGER;
  191.                           VAR initial: ARRAY OF CHAR; enabled: BOOLEAN): I.GadgetPtr;
  192.  
  193. VAR
  194.   ng: GT.NewGadget;
  195.  
  196. (* $CopyArrays- *)
  197.  
  198. BEGIN
  199.   InitNewGadget(ng, id, width, stringHt, label, LONGSET{GT.placeTextLeft});
  200.   prev:= GT.CreateGadget(GT.stringKind, prev, ng, GT.underscore, uScore,
  201.                          GT.stString, SYS.ADR(initial),
  202.                          GT.stMaxChars, LEN(initial) - 1,
  203.                          I.gaTabCycle, I.LTRUE,
  204.                          I.gaDisabled, I.BoolToLong(~enabled),
  205.                          GT.stEditHook, editHook,
  206.                          Util.done);
  207.   RETURN prev;
  208. END CreateStringGad;
  209.  
  210. PROCEDURE CreateTextGad* (label: ARRAY OF CHAR; width: INTEGER;
  211.                         initial: ARRAY OF CHAR): I.GadgetPtr;
  212.  
  213. VAR
  214.   ng: GT.NewGadget;
  215.  
  216. (* $CopyArrays- *)
  217.  
  218. BEGIN
  219.   InitNewGadget(ng, idCnt, width, textHt, label, LONGSET{GT.placeTextLeft});
  220.   INC(idCnt);
  221.   prev:= GT.CreateGadget(GT.textKind, prev, ng, GT.underscore, uScore,
  222.                          GT.txText, SYS.ADR(initial), GT.txCopyText, I.LTRUE,
  223.                          GT.txBorder, I.LTRUE, Util.done);
  224.   RETURN prev;
  225. END CreateTextGad;
  226.  
  227. PROCEDURE CreateIntegerGad* (id: INTEGER; label: ARRAY OF CHAR; width: INTEGER;
  228.                            initial: LONGINT; maxDigits: SHORTINT;
  229.                            enabled: BOOLEAN): I.GadgetPtr;
  230.  
  231. VAR
  232.   ng: GT.NewGadget;
  233.  
  234. (* $CopyArrays- *)
  235.  
  236. BEGIN
  237.   InitNewGadget(ng, id, width, stringHt, label, LONGSET{GT.placeTextLeft});
  238.   prev:= GT.CreateGadget(GT.integerKind, prev, ng, GT.underscore, uScore,
  239.                          GT.inNumber, initial, GT.inMaxChars, maxDigits,
  240.                          I.gaTabCycle, I.LTRUE, I.gaDisabled, I.BoolToLong(~enabled),
  241.                          GT.inEditHook, editHook,
  242.                          Util.done);
  243.   RETURN prev;
  244. END CreateIntegerGad;
  245.  
  246. PROCEDURE CreateCycleGad* (id: INTEGER; label: ARRAY OF CHAR; width: INTEGER;
  247.                            choices: LabelArray; active: SHORTINT; enabled: BOOLEAN): I.GadgetPtr;
  248.  
  249. VAR
  250.   ng: GT.NewGadget;
  251.  
  252. (* $CopyArrays- *)
  253.  
  254. BEGIN
  255.   InitNewGadget(ng, id, width, cycleHt, label, LONGSET{GT.placeTextLeft});
  256.   prev:= GT.CreateGadget(GT.cycleKind, prev, ng, GT.underscore, uScore,
  257.                          GT.cyLabels, choices, GT.cyActive, active,
  258.                          I.gaDisabled, I.BoolToLong(~enabled),
  259.                          Util.done);
  260.   RETURN prev;
  261. END CreateCycleGad;
  262.  
  263. PROCEDURE CreateMXGad* (id: INTEGER; label: ARRAY OF CHAR;
  264.                       choices: LabelArray; active: SHORTINT): I.GadgetPtr;
  265.  
  266. VAR
  267.   ng: GT.NewGadget;
  268.  
  269. (* $CopyArrays- *)
  270.  
  271. BEGIN
  272.   InitNewGadget(ng, id, mxWd, mxHt, label, LONGSET{GT.placeTextRight, GT.highLabel});
  273.   prev:= GT.CreateGadget(GT.mxKind, prev, ng, GT.mxScaled, I.BoolToLong(mxHt # 9),
  274.                          GT.mxLabels, choices, GT.mxActive, active,
  275.                          GT.mxTitlePlace, LONGSET{GT.placeTextAbove},
  276.                          GT.mxSpacing, mxSpacing, Util.done);
  277.   RETURN prev;
  278. END CreateMXGad;
  279.  
  280. PROCEDURE EnqueueOtherGad* (g: I.GadgetPtr);
  281.  
  282. BEGIN
  283.   prev:= g;
  284. END EnqueueOtherGad;
  285.  
  286. PROCEDURE* EditHook(hook: Util.HookPtr; obj, msg: Exec.APTR): Exec.APTR;
  287.  
  288. CONST
  289.   done  = 1;
  290.   unknown       = 0;
  291.  
  292. TYPE
  293.   MsgPtr = UNTRACED POINTER TO STRUCT cmd: LONGINT END;
  294.  
  295. VAR
  296.   sgw: I.SGWorkPtr;
  297.  
  298. BEGIN
  299.   sgw:= SYS.VAL(I.SGWorkPtr, obj);
  300.   IF SYS.VAL(MsgPtr, msg).cmd = I.sghKey THEN
  301.     IF sgw.code = escKey THEN
  302.       sgw.actions:= LONGSET{I.sgaEnd};
  303.     ELSIF (sgw.editOp = I.eoEnter) & (sgw.code # tabKey) THEN
  304.       sgw.actions:= LONGSET{I.sgaUse, I.sgaEnd, I.sgaNextActive};
  305.     END;
  306.     RETURN done;
  307.   ELSE
  308.     RETURN unknown;
  309.   END;
  310. END EditHook;
  311.  
  312. PROCEDURE CreateLabelArray* (VAR array: LabelArray; VAR len: SHORTINT;
  313.                              VAR width: INTEGER; labelDef: ARRAY OF CHAR);
  314.  
  315. VAR
  316.   label: UNTRACED POINTER TO ARRAY 80 OF CHAR;
  317.   p0, p, w: INTEGER;
  318.  
  319. (* $CopyArrays- *)
  320.  
  321. BEGIN
  322.   NEW(array);
  323.   width:= 0; len:= 0; p:= -1;
  324.   REPEAT
  325.     INC(p); INC(len);
  326.     NEW(label); array[len-1]:= label; p0:= p;
  327.     WHILE (labelDef[p] # "|") & (labelDef[p] # 0X) DO
  328.       label[p-p0]:= labelDef[p]; INC(p);
  329.     END;
  330.     label[p-p0]:= 0X;
  331.     w:= TextWidth(label^); IF w > width THEN width:= w END;
  332.   UNTIL labelDef[p] = 0X;
  333.   array[len]:= NIL;  (* terminate *)
  334. END CreateLabelArray;
  335.  
  336. PROCEDURE DisposeLabelArray* (VAR array: LabelArray);
  337.  
  338. VAR
  339.   i: SHORTINT;
  340.  
  341. BEGIN
  342.   i:= 0; WHILE array[i] # NIL DO DISPOSE(array[i]); INC(i) END;
  343.   DISPOSE(array);
  344. END DisposeLabelArray;
  345.  
  346. PROCEDURE ActivateGad* (g: I.GadgetPtr; w: I.WindowPtr);
  347.  
  348. BEGIN
  349.   IF (I.gadgDisabled IN g.flags) OR ~I.ActivateGadget(g^, w, NIL) THEN
  350.     Flash;
  351.   END;
  352. END ActivateGad;
  353.  
  354. PROCEDURE CycleGad* (g: I.GadgetPtr; w: I.WindowPtr; VAR i: SHORTINT; labels: SHORTINT);
  355.  
  356. BEGIN
  357.   IF I.gadgDisabled IN g.flags THEN
  358.     Flash;
  359.   ELSE
  360.     i:= (i + 1) MOD labels;
  361.     GT.SetGadgetAttrs(g^, w, NIL, GT.cyActive, i, Util.done);
  362.   END;
  363. END CycleGad;
  364.  
  365. PROCEDURE ToggleGad* (g: I.GadgetPtr; w: I.WindowPtr; VAR checked: BOOLEAN);
  366.  
  367. BEGIN
  368.   IF I.gadgDisabled IN g.flags THEN
  369.     Flash;
  370.   ELSE
  371.     checked:= ~checked;
  372.     GT.SetGadgetAttrs(g^, w, NIL, GT.cbChecked, I.BoolToLong(checked), Util.done);
  373.   END;
  374. END ToggleGad;
  375.  
  376. PROCEDURE ObtainIMsg* (w: I.WindowPtr): I.IntuiMessagePtr;
  377.  
  378. VAR
  379.   iMsg: I.IntuiMessagePtr;
  380.  
  381. BEGIN
  382.   iMsg:= GT.GetIMsg(w.userPort);
  383.   WHILE iMsg = NIL DO
  384.     Exec.WaitPort(w.userPort);
  385.     iMsg:= GT.GetIMsg(w.userPort);
  386.   END;
  387.   RETURN iMsg;
  388. END ObtainIMsg;
  389.  
  390. PROCEDURE IMsgClass* (class: LONGSET): SHORTINT;
  391.  
  392. VAR
  393.   i: SHORTINT;
  394.  
  395. BEGIN
  396.   FOR i:= 0 TO 31 DO
  397.     IF i IN class THEN RETURN i END;
  398.   END;
  399. END IMsgClass;
  400.  
  401. BEGIN
  402.   reqFontSpec:= IO.screen.font;
  403.   reqFont:= Gfx.OpenFont(reqFontSpec^);
  404.   K.Assert(reqFont # NIL, Err.userNoFont);
  405.  
  406.   idCnt:= 100;
  407.  
  408.   stringHt:= reqFont.ySize + 6;
  409.   buttonHt:= reqFont.ySize + 4;
  410.   checkBoxHt:= reqFont.ySize + 1; IF checkBoxHt < GT.checkboxHeight THEN checkBoxHt:= GT.checkboxHeight END;
  411.   mxHt:= reqFont.ySize - 1; IF mxHt < GT.mxHeight THEN mxHt:= GT.mxHeight END;
  412.   cycleHt:= reqFont.ySize + 6;
  413.   textHt:= reqFont.ySize + 4;
  414.   checkBoxWd:= (GT.checkboxWidth + 1) * checkBoxHt DIV GT.checkboxHeight;
  415.   mxWd:= GT.mxWidth * mxHt DIV GT.mxHeight;
  416.   cycleImgWd:= 23 * cycleHt DIV 14;
  417.   uScoreWd:= Gfx.TextLength(SYS.ADR(IO.screen.rastPort), uScoreCh, 1);
  418.   xWd:= TextWidth("x");
  419.   zeroWd:= TextWidth("0");
  420.   horizSpc:= reqFont.ySize;
  421.   vertSpc:= (horizSpc + 1) DIV 2;
  422.   NEW(editHook);
  423.   Util.InitHook(editHook, EditHook);
  424.  
  425. CLOSE
  426.   IF reqFont # NIL THEN
  427.     Gfx.CloseFont(reqFont);
  428.   END;
  429. END GUI.